home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
Pocket6.3
/
Pocket DA
/
DA Source
/
PocketDA.asm
< prev
next >
Wrap
Assembly Source File
|
1994-06-24
|
9KB
|
330 lines
; File is PocketDA.asm 10:04:36 AM 6/26/87
; Sat Feb 13, 1988 14:37:31 version 1.3+ move DICT control to dSupport.txt
; Tue May 10, 1988 02:46:06 version 1.4 DRVR is purgable
; Thu Jul 04, 1991 11:27:00 version 1.5
; Sat Aug 08, 1992 19:09:00 version 1.6 ( no Apple Events )
; Sat Jan 23, 1993 21:43:00 version 1.6.2 ( bug fix only )
; Fri May 28, 1993 22:16:00 version 1.6.3
; ----- definitions ------
INCLUDE Traps.txt
INCLUDE Macros.txt
JIODone EQU $8FC ; IODone entry location [pointer]
csCode EQU $1A ; param block message record offset
csEvent EQU $1C ; param block event record offset
csMenu EQU $1E ; param block menu offset
dCtlWindow EQU $1E ; DCE window pointer offset
dCtlRefNum EQU $18 ; DCE refNum offset
WindowKind EQU $6C ; Window pointer offset
accEvent EQU $40
accRun EQU $41
accCursor EQU $42
accMenu EQU $43
accUndo EQU $44
useritem EQU 0
staticText EQU 8
disabled EQU 128
OpenJMP EQU 4 ; offsets into the DICT
CloseJMP EQU 8
ControlJMP EQU 0
ExpandJMP EQU 12
evtNum EQU 0 ; event field offset: event type
evtASCII EQU 4 ; event field offset: ASCII code
evtMeta EQU 14 ; event field offset: meta keys
LHeight EQU 11 ; line height
WHeight EQU 178 ; 16 lines
WWidth EQU 384 ; 64 chars
CR EQU $0D ; carrage return
BS EQU 8 ; backspace
BL EQU 32 ; blank
MACRO Base = Baddr | ; start of the address space
MACRO theLink = Base-6 | ; calculate the link address
MACRO BP = A3 | ; base pointer
MACRO DP = A2 | ; compile pointer
MACRO PS = A6 | ; parameter stack pointer
MACRO RS = A7 | ; return stack pointer
MACRO IS = A4 | ; input stream buffer pointer
MACRO Counter = D7 | ; character count
MACRO Dict = D6 | ; start search
.ALIGN 2 ; ------ the DRVR resource ------
RESOURCE 'DRVR' 26 ' Pocket Forth 1.6.3' 32 ; purgable
Start: ; ----- Header ------
DC.W $6400 ; Locked, ctlEnabled
DC.W 2 ; run every 1/30th sec
DC.W 362 ; KeyDown&Auto, button, act & update
DC.W -1 ; a user menu
DC.W Openda-Start
DC.W done-Start ; prime - unused
DC.W Control-Start
DC.W done-Start ; status - unused
DC.W Close-Start
; ----- Data ------
ResID: DC.W 0 ; resource ID to be set at runtime
ResType: DC.L 'DRVR' ; resource type code
ResName: DCB.B 16,0 ; a string for the DA's name
DictH: DC.L 0 ; the DICT's handle
Running: DC.W 0
Openda: ; ----- Open routine ------
MOVEM.L D0-D7/A0-A6,-(SP)
TST.L DCtlWindow(A1) ; be sure this DA's not open
BNE.S GoodOpenDone ; if so, don't make a new one
MOVE.L A1,A4 ; hold the DCE in a stable register
LEA Start,A0 ; A0 has the DA's pointer
_RecoverHandle ; A0 has the DA's handle
MOVE.L A0,-(SP) ; Push DA handle,
PEA ResID ; addr for ID number...
PEA ResType ; addr for type code...
PEA ResName ; addr for a Str(255)
_GetResInfo ; set this resource ID number
JSR OldPort ; save old port on stack
JSR LoadWIND ; load the WIND resource
MOVE.L #512,D0
_NewPtr ; create a pStack block
MOVE.L A0,PS ; carry it there in A6 (PS)
JSR LoadDICT ; load the DICT resource
JSR DictAddr ; get the dictionary address into A0
LEA doExpand,A1 ; carry the expand routine in A1
JSR OwnedID ; carry the ID of the DICT in D0
JSR OpenJMP(A0) ; jsr to the dictionary open
_SetPort ; <-- DICT RETURNS HERE
GoodOpenDone:
MOVEQ #0,D0 ; return no error
OpenDone:
MOVEM.L (A7)+,D0-D7/A0-A6
Done: RTS ; all done, exit
BadOpenDone:
MOVE.W #-1,D0 ; set error condition
BRA.S OpenDone
Close: ; ----- Close routine ------
MOVEM.L D0-D7/A0-A6,-(SP)
MOVE.L DCtlWindow(A1),-(SP) ; push the window
CLR.L DCtlWindow(A1) ; clear the pointer in the DCE
_DisposWindow ; dispose it
JSR DictAddr ; get the dictionary address into
JSR CloseJMP(A0) ; jsr to the DICT's close routine
JSR DisposeDICT ; <-- DICT RETURNS HERE
BRA.S GoodOpenDone ; all done with close
Control: ; ----- Control routine ------
MOVEM.L D0-D7/A0-A6,-(SP)
LEA running,A3
TST (A3)
BNE.S cdone
MOVE #-1,(A3)
MOVE.L A0,D4 ; pBlock always in D4 during control
JSR OldPort ; save old port on stack
JSR DictAddr ; get the dictionary address into
JSR ControlJMP(A0) ; jsr to the dictionary control
_SetPort ; <-- DICT RETURNS HERE
LEA running,A0
CLR (A0)
CDone: MOVEM.L (A7)+,D0-D7/A0-A6
MOVEQ #0,D0 ; no error
MOVE.L JIODone,-(SP) ; jump to IODone
RTS
; ----- Expand routine ( entry from DICT ) ------
doExpand:
MOVE.L DictH,A0
_HUnlock ; unlock the dictionary
_GetHandleSize ; add the passed in size ...
ADD (A6)+,D0 ; ...to the previous size and ...
_SetHandleSize ; ... reset dictionary size
_HLock
JSR DictAddr ; get the dictionary address
JMP ExpandJMP(A0) ; jsr to the dictionary expand
; ----- subroutines ------
LoadDICT: ; load in the DICT
CLR.L -(SP) ; room for dict handle
MOVE.L #'DICT',-(SP) ; type of resource
BSR.S OwnedID
ADD.W #0,D0 ; plus the 'private' ID of the DICT
MOVE.W D0,-(SP)
_GetResource
LEA DictH,A0 ; stash the resource handle
MOVE.L (SP)+,(A0)
MOVE.L (A0),A0
_HLock ; Lock the DICT
RTS
OwnedID: ; get an owned ID number into D0
MOVE ResID,D0 ; this DA's ID
ASL #5,D0 ; times 32
OR #$C000,D0 ; -16384
RTS
LoadWIND:
CLR.L -(SP) ; make room for the new window pointer
BSR.S OwnedID
ADD.W #0,D0 ; plus the 'private' ID of the WIND
MOVE.W D0,-(SP)
CLR.L -(SP) ; put it on the heap
MOVE.L #-1,-(SP) ; behind none
bsr.s qcolor
BEQ.S @1
_GetNewCWindow
BRA.S @2
@1: _GetNewWindow
@2: MOVE.L (SP)+,A0
MOVE.L A0,DCtlWindow(A4) ; put window pointer into DCE
MOVE.W DCtlRefNum(A4),WindowKind(A0) ; mark as system window
RTS
QColor: ; true if color
; check for 64K ROM
MOVE #$A86E,D0 ; _InitGraf
_GetTrapAddress.newTool
MOVE.L A0,D1
MOVE #$AA6E,D0 ; _InitGraf AND $200
_GetTrapAddress.newTool
CMP.L A0,D1
BEQ.S nc ; 64KROM -- no color back then
; Check for gestalt
MOVE.W #$A89F,D0 ; _Unimplemented
_GetTrapAddress.newTool ; NGetTrapAddress
MOVE.L A0,D1
MOVE.W #$A1AD,D0 ; _Gestalt
_GetTrapAddress.newOS ; NGetTrapAddress
CMP.L A0,D1
BEQ.S nc ; no gestalt -- assume no color
; run gestalt
MOVE.L #'qd ',D0
_Gestalt
CMPA.L #$100,A0
BLT.S nc
moveq #-1,d0
RTS
nc: clr d0
RTS
DICTAddr: ; return the address of the DICT's block in A0
MOVE.L DictH,A0 ; get the DICT's handle
MOVE.L (A0),D0 ; dereference into D0
ANDI.L #$1FFFFFFF,D0 ; mask out resource flags
MOVE.L D0,A0 ; load the jump address
RTS
DisposeDICT:
MOVE.L DictH,-(SP) ; the DICT's handle
_ReleaseResource ; dispose of the DICT
RTS
OldPort:
MOVE.L (SP)+,D3 ; hold return address
SUBQ.L #4,SP ; open a hole in the stack
MOVE.L SP,-(SP) ; push address of the hole
_GetPort ; put the port into the hole
MOVE.L D3,-(SP) ; restore the return address
RTS
.ALIGN 2 ; ----- the DICT resource ------
RESOURCE 'DICT' $C340 'PocketForth' 16 ; locked (not necc. to be p'able)
Baddr: ; start of forth's address space
Bottom: JMP DictControl ; jump into sections of the driver
JMP DictOpen
JMP DictClose
JMP GRet
DictOpen: ; ----- Open routine------
LEA Baddr,BP ; Set the base pointer
MOVE D0,MyID-base(BP) ; set the id holder
MOVE.L A1,Expand-base(BP) ; set the expand routine's address
MOVE.L PS,PStackH-base(BP)
MOVE.L DCtlWindow(A4),-(SP)
MOVE.L (SP),theWindow-base(BP) ; Put the window into theWindow
MOVE.L (SP),-(SP)
MOVE.L WSize-base(BP),-(SP)
CLR.W -(SP)
_SizeWindow
MOVE.L (SP),-(SP)
_ShowWindow
_SetPort
ADDA.L #512,PS
MOVE.L PS,UFlow-base(BP)
SUBQ.L #2,PS ; leave a 2 byte underflow buffer
MOVE.L PS,SZero-base(BP)
CLR.L Dict
MOVE DictPt-base(BP),Dict ; Set the dictionary search pointer
MOVE FreePt-base(BP),D0
LEA 0(BP,D0.W),DP ; set the compile pointer
LEA TermBuf-base(BP),IS ; set the input stream pointer
CLR.L Counter ; clear character count
CLR.L fcolon-base(BP) ; set the compiler flags
BSET.B #7,fint-base(BP)
MOVE.L #10,D0
_NewHandle ; pasting text block
MOVE.L A0,TextH-base(BP)
MOVE.L #10,D0
_NewHandle ; to save rStack during "key"
MOVE.L A0,oldStackH-base(BP)
MOVE freesz-base(BP),-(PS)
JSR grow-base(BP) ; grow to the current size
JSR ClearTermBuf-base(BP)
JSR Page-base(BP)
MOVE opener-base(BP),D0
JSR 0(BP,D0) ; run the open routine 3/30/88
JSR SaveFRegs-base(BP) ; save the initial register values
RTS
DictClose: ; ----- Close routine ------
JSR SetFRegs ; set the Forth registers
MOVE Closer-base(BP),D0
JSR 0(BP,D0.W) ; jump to the closer vector
MOVE.L PStackH-base(BP),A0
_DisposPtr ; dispose of the stack block
MOVE.L TextH,A0
_DisposHandle ; dispose of the private scrap block
MOVE.L OldStackH,A0
_DisposHandle ; dispose of "key"'s storage
RTS
INCLUDE dSupport.txt ; unnamed interface routines
INCLUDE dInterp.txt ; interpreter words
INCLUDE dDict.txt
.ALIGN 2 ; ----- the WIND resource ------
RESOURCE 'WIND' $C340 'PocketForth' 32 ; purgable
DC.W 40,2,41,102
DC.W 4 ; no grow doc proc
DC.W 0 ; invisable
DC.W $100 ; closable
DC.L 0
DC.B 18,'Pocket Forth 1.6.3'
.ALIGN 2 ; ----- the signature resource for identification ------
RESOURCE 'p4TH' $C340 'PocketForth' 32 ; purgable
DC.B 25,'v1.6.3 C.Heilman 7/4/93'
END